明治維新は、まずは西欧から「学ぶ」ことに特化したのである。

#remotes::install_git("https://gitee.com/JohnCoene/echarts4r")
lib('echarts4r')
## 载入需要的程辑包：echarts4r

echarts4r TRUE

mtcars |> 
  e_charts(disp) |> 
  e_scatter(mpg, qsec) |> 
  e_loess(mpg ~ disp)
iris |> 
  group_by(Species) |> 
  e_charts(Sepal.Length) |> 
  e_line(Sepal.Width) |> 
  e_lm(Sepal.Width ~ Sepal.Length) |> 
  e_x_axis(min = 4)
df <- data.frame(
  x = seq(50),
  y = rnorm(50, 10, 3),
  z = rnorm(50, 11, 2),
  w = rnorm(50, 9, 2)
)

df |> 
  e_charts(x) |> 
  e_line(z) |> 
  e_area(w) |> 
  e_title("Line and area charts")
df |> 
  e_charts(x) |> 
  e_polar() |> 
  e_angle_axis(x) |> # angle = x
  e_radius_axis() |> 
  e_bar(y, coord_system = "polar") |> 
  e_scatter(z, coord_system = "polar")
df |> 
  head(10) |> 
  e_charts(x) |> 
  e_polar() |> 
  e_angle_axis() |> 
  e_radius_axis(x) |> 
  e_bar(y, coord_system = "polar") |> 
  e_scatter(z, coord_system = "polar")
df <- data.frame(
  x = LETTERS[1:5],
  y = runif(5, 1, 5),
  z = runif(5, 3, 7)
)

df |> 
  e_charts(x) |> 
  e_radar(y, max = 7, name = "radar") |>
  e_radar(z, max = 7, name = "chart") |>
  e_tooltip(trigger = "item")
技能评估（从新兵1至专业10）
序列 技能 程度
1 计量经济学 9
2 量化交易 9
3 ®编程 9
4 微软办公软件 8
5 SQL语言 3
6 派森编程语言 4
7 数据分析 9
8 客服工作 9
9 体育博彩行业 7
10 建立®Studio服务器 7
11 统计学 6
12 数据科学 8
13 闪霓应用 8
14 李呢克斯🐧操作系统 7
15 网页应用程序接口 6
16 Sparklyr大数据分析 2
17 量化分析 8
18 高级®编程 6
19 modeltime / tidyverts / prophet 7
20 tidyverse / tidymodels 6
21 张量Tensorflow / Pytorch 2
22 浏览器驱动 4
23 FrontPage / 部署网站 3
24 Photoshop / Picsart 5 
# Library
library(fmsb)
 
# Create data: note in High school for Jonathan:
data <- as.data.frame(matrix( sample( 2:20 , 10 , replace=T) , ncol=10))
colnames(data) <- c("math" , "english" , "biology" , "music" , "R-coding", "data-viz" , "french" , "physic", "statistic", "sport" )
 
# To use the fmsb package, I have to add 2 lines to the dataframe: the max and min of each topic to show on the plot!
data <- rbind(rep(20,10) , rep(0,10) , data)
 
# Check your data, it has to look like this!
# head(data)

# The default radar chart 
radarchart(data)

# Library
library(fmsb)
 
# Create data: note in High school for Jonathan:
data <- as.data.frame(matrix( sample( 2:20 , 10 , replace=T) , ncol=10))
colnames(data) <- c("math" , "english" , "biology" , "music" , "R-coding", "data-viz" , "french" , "physic", "statistic", "sport" )
 
# To use the fmsb package, I have to add 2 lines to the dataframe: the max and min of each topic to show on the plot!
data <- rbind(rep(20,10) , rep(0,10) , data)
 
# Check your data, it has to look like this!
# head(data)

# Custom the radarChart !
radarchart( data  , axistype=1 , 
 
    #custom polygon
    pcol=rgb(0.2,0.5,0.5,0.9) , pfcol=rgb(0.2,0.5,0.5,0.5) , plwd=4 , 
 
    #custom the grid
    cglcol="grey", cglty=1, axislabcol="grey", caxislabels=seq(0,20,5), cglwd=0.8,
 
    #custom labels
    vlcex=0.8 
    )

library(radarchart)

labs <- c("Communicator", "Data Wangler", "Programmer",
          "Technologist",  "Modeller", "Visualizer")

scores <- list(
  "Rich" = c(9, 7, 4, 5, 3, 7),
  "Andy" = c(7, 6, 6, 2, 6, 9),
  "Aimee" = c(6, 5, 8, 4, 7, 6)
)

chartJSRadar(scores = scores, labs = labs, maxScale = 10)
scores <- data.frame("Label"=c("Communicator", "Data Wangler", "Programmer",
                     "Technologist",  "Modeller", "Visualizer"),
                     "Rich" = c(9, 7, 4, 5, 3, 7),
                     "Andy" = c(7, 6, 6, 2, 6, 9),
                     "Aimee" = c(6, 5, 8, 4, 7, 6))

chartJSRadar(scores, maxScale = 10, showToolTipLabel=TRUE)
chartJSRadar(skills, main = "Data Science Radar")
chartJSRadarOutput("ID", width = "450", height = "300")

#runExampleApp("basic")
lib('fmsb', 'scales')
## 载入需要的程辑包：scales
## 
## 载入程辑包：'scales'
## The following objects are masked from 'package:formattable':
## 
##     comma, percent, scientific
## The following object is masked from 'package:purrr':
## 
##     discard
## The following object is masked from 'package:readr':
## 
##     col_factor

fmsb scales TRUE TRUE

lib(c('ggradar', 'rescale', 'lattice', 'rgl', 'akima', 'metan'))
## 载入需要的程辑包：ggradar
## 载入需要的程辑包：rescale
## 
## 载入程辑包：'rescale'
## The following object is masked from 'package:scales':
## 
##     rescale
## 载入需要的程辑包：lattice
## 载入需要的程辑包：rgl
## 载入需要的程辑包：akima
## 载入需要的程辑包：metan
## Registered S3 method overwritten by 'GGally':
##   method from   
##   +.gg   ggplot2
## |=========================================================|
## | Multi-Environment Trial Analysis (metan) v1.16.0        |
## | Author: Tiago Olivoto                                   |
## | Type 'citation('metan')' to know how to cite metan      |
## | Type 'vignette('metan_start')' for a short tutorial     |
## | Visit 'https://bit.ly/pkgmetan' for a complete tutorial |
## |=========================================================|
## 
## 载入程辑包：'metan'
## The following object is masked from 'package:magrittr':
## 
##     set_class
## The following object is masked from 'package:MASS':
## 
##     select
## The following object is masked from 'package:forcats':
## 
##     as_factor
## The following object is masked from 'package:dplyr':
## 
##     recode_factor
## The following object is masked from 'package:tidyr':
## 
##     replace_na
## The following objects are masked from 'package:tibble':
## 
##     column_to_rownames, remove_rownames, rownames_to_column

ggradar rescale lattice rgl akima metan TRUE TRUE TRUE TRUE TRUE TRUE

df_maxmin <- data.frame(
    drat = c(1, 0),
    wt = c(1, 0),
    qsec = c(1, 0),
    vs = c(1, 0),
    am = c(1, 0))

#load data
mtcars_radar <- mtcars %>% 
  as_tibble(rownames = "group") %>% 
  mutate_at(vars(-group), rescale) %>% 
  tail(2) %>% 
  dplyr::select(1,6:10)
## Error in `mutate()`:
## ! Problem while computing `mpg = (function (data, data2 = data, center =
##   character(0), scale = character(0)) ...`.
## Caused by error in `err()`:
## ! `data` must be a data.frame.
#check data type with std() function
str(mtcars_radar)
## Error in str(mtcars_radar): 找不到对象'mtcars_radar'
mtcars_radar <- mtcars_radar[,c('drat','wt','qsec','vs','am')]
## Error in eval(expr, envir, enclos): 找不到对象'mtcars_radar'
mtcars_radar <- rbind(df_maxmin, mtcars_radar)
## Error in rbind(deparse.level, ...): 找不到对象'mtcars_radar'
fmsb::radarchart(mtcars_radar)
## Error in is.data.frame(df): 找不到对象'mtcars_radar'
#devtools::install_github('ricardo-bion/ggradar', dependencies = TRUE, force = T)
#devtools::install_github("poissonconsulting/rescale")
lib(c('ggradar', 'rescale', 'lattice', 'rgl', 'akima', 'metan'))

ggradar rescale lattice rgl akima metan TRUE TRUE TRUE TRUE TRUE TRUE

x=runif(1000)
y=runif(1000)
z=rnorm(1000)
s=interp(x,y,z,duplicate="strip")
surface3d(s$x,s$y,s$z,color="blue")
points3d(s)


x <- seq(-10, 10, length.out = 50)  
y <- x  
rotsinc <- function(x,y) {
    sinc <- function(x) { y <- sin(x)/x ; y[is.na(y)] <- 1; y }  
    10 * sinc( sqrt(x^2+y^2) )  
}

z <- outer(x, y, rotsinc)  
persp(x, y, z)

surface3d(x, y, z)


# begin generating my 3D shape
b <- seq(from=0, to=20,by=0.5)
s <- seq(from=0, to=20,by=0.5)
payoff <- expand.grid(b=b,s=s)
payoff$payoff <- payoff$b - payoff$s
payoff$payoff[payoff$payoff < -1] <- -1
# end generating my 3D shape


wireframe(payoff ~ s * b, payoff, shade = TRUE, aspect = c(1, 1),
    light.source = c(10,10,10), main = "Study 1",
    scales = list(z.ticks=5,arrows=FALSE, col="black", font=10, tck=0.5),
    screen = list(z = 40, x = -75, y = 0))

plot_rgl_model_a <- function(fdata, plot_contour = T, plot_points = T, 
                             verbose = F, colour = "rainbow", smoother = F){
  ## takes a model in long form, in the format
  ## 1st column x
  ## 2nd is y,
  ## 3rd is z (height)
  ## and draws an rgl model

  ## includes a contour plot below and plots the points in blue
  ## if these are set to TRUE

  # note that x has to be ascending, followed by y
  if (verbose) print(head(fdata))

  fdata <- fdata[order(fdata[, 1], fdata[, 2]), ]
  if (verbose) print(head(fdata))
  ##
  require(reshape2)
  require(rgl)
  orig_names <- colnames(fdata)
  colnames(fdata) <- c("x", "y", "z")
  fdata <- as.data.frame(fdata)

  ## work out the min and max of x,y,z
  xlimits <- c(min(fdata$x, na.rm = T), max(fdata$x, na.rm = T))
  ylimits <- c(min(fdata$y, na.rm = T), max(fdata$y, na.rm = T))
  zlimits <- c(min(fdata$z, na.rm = T), max(fdata$z, na.rm = T))
  l <- list (x = xlimits, y = ylimits, z = zlimits)
  xyz <- do.call(expand.grid, l)
  if (verbose) print(xyz)
  x_boundaries <- xyz$x
  if (verbose) print(class(xyz$x))
  y_boundaries <- xyz$y
  if (verbose) print(class(xyz$y))
  z_boundaries <- xyz$z
  if (verbose) print(class(xyz$z))
  if (verbose) print(paste(x_boundaries, y_boundaries, z_boundaries, sep = ";"))

  # now turn fdata into a wide format for use with the rgl.surface
  fdata[, 2] <- as.character(fdata[, 2])
  fdata[, 3] <- as.character(fdata[, 3])
  #if (verbose) print(class(fdata[, 2]))
  wide_form <- dcast(fdata, y ~ x, value_var = "z")
  if (verbose) print(head(wide_form))
  wide_form_values <- as.matrix(wide_form[, 2:ncol(wide_form)])  
  if (verbose) print(wide_form_values)
  x_values <- as.numeric(colnames(wide_form[2:ncol(wide_form)]))
  y_values <- as.numeric(wide_form[, 1])
  if (verbose) print(x_values)
  if (verbose) print(y_values)
  wide_form_values <- wide_form_values[order(y_values), order(x_values)]
  wide_form_values <- as.numeric(wide_form_values)
  x_values <- x_values[order(x_values)]
  y_values <- y_values[order(y_values)]
  if (verbose) print(x_values)
  if (verbose) print(y_values)

  if (verbose) print(dim(wide_form_values))
  if (verbose) print(length(x_values))
  if (verbose) print(length(y_values))

  zlim <- range(wide_form_values)
  if (verbose) print(zlim)
  zlen <- zlim[2] - zlim[1] + 1
  if (verbose) print(zlen)

  if (colour == "rainbow"){
    colourut <- rainbow(zlen, alpha = 0)
    if (verbose) print(colourut)
    col <- colourut[ wide_form_values - zlim[1] + 1]
    # if (verbose) print(col)
  } else {
    col <- "grey"
    if (verbose) print(table(col2))
  }


  open3d()
  plot3d(x_boundaries, y_boundaries, z_boundaries, 
         box = T, col = "black",  xlab = orig_names[1], 
         ylab = orig_names[2], zlab = orig_names[3])

  rgl.surface(z = x_values,  ## these are all different because
              x = y_values,  ## of the confusing way that 
              y = wide_form_values,  ## rgl.surface works! - y is the height!
              coords = c(2,3,1),
              color = col,
              alpha = 1.0,
              lit = F,
              smooth = smoother)

  if (plot_points){
    # plot points in red just to be on the safe side!
    points3d(fdata, col = "blue")
  }

  if (plot_contour){
    # plot the plane underneath
    flat_matrix <- wide_form_values
    if (verbose) print(flat_matrix)
    y_intercept <- (zlim[2] - zlim[1]) * (-2/3) # put the flat matrix 1/2 the distance below the lower height 
    flat_matrix[which(flat_matrix != y_intercept)] <- y_intercept
    if (verbose) print(flat_matrix)

    rgl.surface(z = x_values,  ## these are all different because
                x = y_values,  ## of the confusing way that 
                y = flat_matrix,  ## rgl.surface works! - y is the height!
                coords = c(2,3,1),
                color = col,
                alpha = 1.0,
                smooth = smoother)
  }
}



add_rgl_model <- function(fdata){

  ## takes a model in long form, in the format
  ## 1st column x
  ## 2nd is y,
  ## 3rd is z (height)
  ## and draws an rgl model

  ##
  # note that x has to be ascending, followed by y
  print(head(fdata))

  fdata <- fdata[order(fdata[, 1], fdata[, 2]), ]

  print(head(fdata))
  ##
  require(reshape2)
  require(rgl)
  orig_names <- colnames(fdata)

  #print(head(fdata))
  colnames(fdata) <- c("x", "y", "z")
  fdata <- as.data.frame(fdata)

  ## work out the min and max of x,y,z
  xlimits <- c(min(fdata$x, na.rm = T), max(fdata$x, na.rm = T))
  ylimits <- c(min(fdata$y, na.rm = T), max(fdata$y, na.rm = T))
  zlimits <- c(min(fdata$z, na.rm = T), max(fdata$z, na.rm = T))
  l <- list (x = xlimits, y = ylimits, z = zlimits)
  xyz <- do.call(expand.grid, l)
  #print(xyz)
  x_boundaries <- xyz$x
  #print(class(xyz$x))
  y_boundaries <- xyz$y
  #print(class(xyz$y))
  z_boundaries <- xyz$z
  #print(class(xyz$z))

  # now turn fdata into a wide format for use with the rgl.surface
  fdata[, 2] <- as.character(fdata[, 2])
  fdata[, 3] <- as.character(fdata[, 3])
  #print(class(fdata[, 2]))
  wide_form <- dcast(fdata, y ~ x, value_var = "z")
  print(head(wide_form))
  wide_form_values <- as.matrix(wide_form[, 2:ncol(wide_form)])  
  x_values <- as.numeric(colnames(wide_form[2:ncol(wide_form)]))
  y_values <- as.numeric(wide_form[, 1])
  print(x_values)
  print(y_values)
  wide_form_values <- wide_form_values[order(y_values), order(x_values)]
  x_values <- x_values[order(x_values)]
  y_values <- y_values[order(y_values)]
  print(x_values)
  print(y_values)

  print(dim(wide_form_values))
  print(length(x_values))
  print(length(y_values))

  rgl.surface(z = x_values,  ## these are all different because
              x = y_values,  ## of the confusing way that 
              y = wide_form_values,  ## rgl.surface works!
              coords = c(2,3,1),
              alpha = .8)
  # plot points in red just to be on the safe side!
  points3d(fdata, col = "red")
}
x=runif(1000)
y=runif(1000)
z=rnorm(1000)
s=interp(x,y,z,duplicate="strip")
surface3d(s$x,s$y,s$z,color="blue")
points3d(s)
lib('ggplot2')

ggplot2 TRUE

lib('rayshader')
## 载入需要的程辑包：rayshader

rayshader TRUE

conflict_prefer("select", "dplyr")
## [conflicted] Removing existing preference
## [conflicted] Will prefer dplyr::select over any other package
df <- data.frame(
  YearMonth = c(202101L,202101L,202101L,
                202102L,202102L,202102L,202103L,202103L,202103L),
  Product = c("bike","car","skateboard",
              "bike","car","skateboard","bike","car","skateboard"),
  Sales = c(100L, 40L, 60L, 70L, 30L, 50L, 50L, 20L, 30L)
)
df <- rbind(df, subset(df, subset = Product == "bike"))
df$height <- match(df$YearMonth, sort(unique(df$YearMonth)))
df

YearMonth Product Sales height 1 202101 bike 100 1 2 202101 car 40 1 3 202101 skateboard 60 1 4 202102 bike 70 2 5 202102 car 30 2 6 202102 skateboard 50 2 7 202103 bike 50 3 8 202103 car 20 3 9 202103 skateboard 30 3 11 202101 bike 100 1 41 202102 bike 70 2 71 202103 bike 50 3

# Define a new coordinate system from coord_polar
coord_radar <- function(theta = "x", start = 0, direction = 1, clip = "on") {
  theta <- match.arg(theta, c("x", "y"))
  r <- if (theta == "x")
    "y"
  else "x"
  ggproto(NULL, CoordPolar, theta = theta, r = r, start = start,
          direction = sign(direction), clip = clip,
          # This is the change to make the lines straight
          is_linear = function() TRUE
          )
}

plot2d <- ggplot(df, aes(x = Product, y = Sales, color = height)) + 
  geom_path(aes(group = YearMonth)) + 
  scale_color_continuous() +
  guides(color = "none") + 
  coord_radar()

plot_gg(plot2d, raytrace = FALSE)
library(tidyverse)
library(shiny)
library(plotly)

pokemons <- 
read_table('
  name      hp  defense attack sp_attack sp_defense speed
  Bulbasaur 45      49     49        65         65    45
    Ivysaur 60      63     62        80         80    60
   Venusaur 80     123    100       122        120    80
 Charmander 39      43     52        60         50    65
 Charmeleon 58      58     64        80         65    80
  Charizard 78      78    104       159        115   100')



ui <- navbarPage(title = "Pokemon Research",

                 tabPanel(title = "Pokemon Statistics",
                          sidebarPanel(
                              selectInput(inputId = "indv",
                                          label = "Pokemon",
                                          choices = pokemons$name, 
                                          selected = 'Bulbasaur')
                              ),
                          mainPanel(
                              plotlyOutput('radar') #the radar plot
                          )
                          ))

server <- function(input, output, session) {

    output$radar <- renderPlotly({
        pkmn <- filter(pokemons, name == input$indv)
        
        r <- map_dbl(pkmn[, 2:6], ~.x)
        nms <- names(r)
        
        #code to plot the radar
        fig <- plot_ly(
            type = 'scatterpolar',
            r = r,
            theta = nms,
            fill = 'toself',
            mode = 'markers'
        ) 
        fig <- fig %>%
            layout(
                polar = list(
                    radialaxis = list(
                        visible = T,
                        range = c(0,max(r))
                    )
                ),
                showlegend = F
            )
    })
}

shinyApp(ui, server)
## 
## Listening on http://127.0.0.1:8359

## https://codepen.io/duggi/pen/gPjrKM#_=_
## https://xiangyun.rbind.io/2021/11/interactive-web-graphics
lib('apexcharter')
## 载入需要的程辑包：apexcharter

apexcharter TRUE

mtcars$model <- rownames(mtcars)
apex(data = head(mtcars), type = "radar", mapping = aes(x = model, y = qsec))
# extremely complicated reshaping
new_mtcars <- reshape(
  data = head(mtcars), 
  idvar = "model", 
  varying = list(c("drat", "wt")),
  times = c("drat", "wt"),
  direction = "long",
  v.names = "value",
  drop = c("mpg", "cyl", "hp", "dist", "qsec", "vs", "am", "gear", "carb")
)

apex(data = new_mtcars, type = "radar", mapping = aes(x = model, y = value, group = time))
lib('JuliaCall')
julia_install_package_if_needed("Optim")
julia_installed_package("Optim")
#> [1] "0.22.0"
julia_library("Optim")

我正在使用 echarts4r 创建一个圆环图.现在我正在尝试添加自定义工具提示，并且可以复制此处给出的示例 Echarts4r : Create stacked area chart with percentage from total in tooltip 和这里 Displaying extra variables in tooltips echarts4r .但是，我不太明白这是如何扩展到饼图的。我想要一个带有工具提示的饼图，显示总数和相对百分比

library(tidyverse)
library(echarts4r)

My_df <- data.frame(n = c(1, 4, 10), 
                    x = c("A", "B", " C")) %>%
  mutate(percent = round(n/sum(n), 2) )

My_df %>%
  e_charts(x)  %>% 
  e_pie(n, radius = c("50%", "70%")) %>%
  e_tooltip()

这是我迄今为止最好的一次拍摄

My_df %>%
  e_charts(x)  %>% 
  e_pie(n, radius = c("50%", "70%")) %>%
  e_tooltip(formatter = htmlwidgets::JS("
                                        function(params){
                                        return('<strong>' + params.name + 
                                        '</strong><br />total: ' + params.value + 
                                        '<br />percent: ' +  params.value[1])   }  "))

在散点图示例中，使用 bind = 附加了额外的值。但这不适用于饼图。 最佳答案

你不能用params.percent ?

My_df %>%
  e_charts(x)  %>% 
  e_pie(n, radius = c("50%", "70%")) %>%
  e_tooltip(formatter = htmlwidgets::JS("
                                        function(params){
                                        return('<strong>' + params.name + 
                                        '</strong><br />total: ' + params.value + 
                                        '<br />percent: ' +  params.percent)  +'%' }  "))

您也可以使用 Javascript template literals 整理一下。

My_df %>%
  e_charts(x)  %>% 
  e_pie(n, radius = c("50%", "70%")) %>%
  e_tooltip(formatter = htmlwidgets::JS("
                                        function(params)
                                        {
                                            return `<strong>${params.name}</strong>
                                                    <br/>Total: ${params.value}
                                                    <br/>Percent: ${params.percent}%`
                                        }  "))
My_df %>%
  e_charts(x)  %>% 
  e_radar(n, radius = c("50%", "70%")) %>%
  e_tooltip(formatter = htmlwidgets::JS("
                                        function(params)
                                        {
                                            return `<strong>${params.name}</strong>
                                                    <br/>Total: ${params.value}
                                                    <br/>Percent: ${params.percent}%`
                                        }  "))